home *** CD-ROM | disk | FTP | other *** search
/ Mac100% 1998 November / MAC100-1998-11.ISO.7z / MAC100-1998-11.ISO / ｵﾝﾗｲﾝｿﾌﾄ定点観測 / ﾕｰﾃｨﾘﾃｨ / Mops 3.2.sea / Mops 3.2 / Mops ƒ / String < prev    next >
Text File  |  1996-12-31  |  6KB  |  269 lines
  1. ¥ String class.
  2.  
  3. cr .( loading String...)
  4.  
  5. ¥ This class is changed radically from Neon!  We now keep two offsets into a string
  6. ¥ - POS and LIM.  POS marks the "current" position, and LIM the "current" end.
  7. ¥ Most string operations operate on the substring delimited by POS and LIM, which
  8. ¥ we call the active part of the string. We also keep the size of the string (the
  9. ¥ real size, that is) in an ivar, so that we can get it quickly without a system
  10. ¥ call.
  11.  
  12.    $ D    constant    RET            ¥ Carriage return character
  13.  
  14. : $ER
  15.     setFwind
  16.     cr ." size: " .  ."   pos: " .  ."   lim: " .
  17.     89 die   ;
  18.  
  19. ' $er  -> $err
  20.  
  21. : $=  { addr1 len1 addr2 len2 -- }
  22.     word0  addr1  addr2  len1  len2  pack  w 10
  23.     trap$ a9ed                                ¥ IUMagString
  24.     i->l  ;
  25.  
  26.  
  27. : NOPEN    ." (not open)"  ;
  28.  
  29.  
  30. :class    STRING    super{ handle }        general
  31.  
  32. record
  33. {    var    SIZE
  34.     var    POS
  35.     var    LIM
  36.     int    FLAGS
  37. }
  38.  
  39. :m COPYTO:    ¥ Redefinition of COPYTO: which will disallow a size change
  40.             ¥ on the copy.  I found it was fairly easy to do this
  41.             ¥ accidentally, and get into random crash territory.
  42.     copyto: super
  43.     1 put: flags   ;m
  44.  
  45.  
  46. :m MARK_ORIGINAL:
  47. ¥ Overrides the above check.  Marks a copy as original, so we can change its
  48. ¥ size.  We hope we know what we're doing.  At least this is a long name
  49. ¥ which could hardly get typed by accident!!
  50.  
  51.     clear: flags   ;m
  52.  
  53.  
  54. :m HANDLE:        ¥ this method returns the handle - replaces get: in super
  55.     inline{ obj @}
  56.     ^base @  ;m
  57.  
  58. :m POS:        ¥ ( -- pos )
  59.     inline{ get: pos}
  60.     get: pos  ;m
  61.  
  62. :m >POS:    ¥ ( newpos -- )
  63.     inline{ put: pos}
  64.     put: pos  ;m
  65.  
  66. :m LIM:        ¥ ( -- lim )
  67.     inline{ get: lim}
  68.     get: lim  ;m
  69.  
  70. :m >LIM:    ¥ ( newlim -- )
  71.     inline{ put: lim}
  72.     put: lim  ;m
  73.  
  74. :m LEN:        ¥ ( -- length )
  75.     get: lim  get: pos  -   ;m
  76.  
  77. :m >LEN:    ¥ ( newlength -- )
  78.     get: pos  +  put: lim  ;m
  79.  
  80.  
  81. :m SKIP:    ¥ ( n -- )  Increments POS by n.
  82.     inline{ +: pos}
  83.     +: pos  ;m
  84.  
  85. :m MORE:    ¥ ( n -- )  Increments LIM by n.
  86.     inline{ +: lim}
  87.     +: lim  ;m
  88.  
  89. :m START:    ¥ Sets POS to 0 (the start of the string).
  90.     inline{ clear: pos}
  91.     clear: pos  ;m
  92.  
  93. :m BEGIN:    ¥ Sets POS and LIM to 0, ready to begin some operation.
  94.     clear: pos  clear: lim   ;m
  95.  
  96. :m END:        ¥ Sets POS and LIM to the end of the string.
  97.     get: size  dup  put: pos  put: lim  ;m
  98.  
  99. :m NOLIM:    ¥ Sets LIM to the end of the string.
  100.     inline{ get: size put: lim}
  101.     get: size  put: lim  ;m
  102.  
  103. :m RESET:    ¥ Sets POS to 0, and LIM to the end.
  104.     inline{ clear: pos  get: size  put: lim}
  105.     clear: pos  get: size  put: lim  ;m
  106.  
  107. :m STEP:    ¥ Steps down the string, by setting POS to LIM and
  108.             ¥ then setting LIM to the end.
  109.     get: lim  put: pos  get: size  put: lim  ;m
  110.  
  111. :m <STEP:    ¥ Backward step.  Sets LIM to POS, then POS to 0.
  112.     get: pos  put: lim  clear: pos  ;m
  113.  
  114.  
  115. :m NEW:
  116.     0 new: super
  117.     clear: size  clear: pos  clear: lim  clear: flags  ;m
  118.     
  119. :m ?NEW:
  120.     ^base @  nilH <> ?EXIT  new: self  ;m
  121.  
  122. :m SIZE:    ¥ ( -- size )
  123.     inline{ get: size}
  124.     get: size   ;m
  125.  
  126. :m SETSIZE:    ¥ ( newsize -- )
  127.     get: flags  ?error 94        ¥ Can't do that on a string copy
  128.     ?new: self
  129.     dup  setsize: super  put: size  reset: self  ;m
  130.  
  131. :m CLEAR:
  132.     ?new: self  0 setsize: self  ;m
  133.  
  134. :m GET:        ¥ ( -- addr len ).  Gets the active part of the string.
  135.     $chk
  136.     ptr: self  get: pos  +  get: lim  get: pos  -  ;m
  137.  
  138. :m ALL:        ¥ ( -- addr len )    Gets all the string, ignoring POS and LIM.
  139.     ptr: self  size: self  ;m
  140.  
  141. :m 1ST:        ¥ ( -- c )  Returns the char at POS.
  142.     ptr: self  get: pos  +  c@  ;m
  143.  
  144. :m ^1ST:    ¥ ( -- addr )  Returns the addr of the char at POS.
  145.     ptr: self  get: pos  +  ;m
  146.  
  147. private
  148.  
  149. :m MUNGER:  { addr1 len1 addr2 len2 -- offs }
  150.         ¥ Interface to the Toolbox Munger utility
  151.     $chk
  152.     get: flags  ?error 94        ¥ Can't do that on a string copy
  153.        0                            ¥ For returned result
  154.     ^base @  get: pos
  155.     addr1 len1  addr2 len2
  156.     trap$ a9e0                    ¥ call Munger
  157.     size: super  put: size  ;m
  158.  
  159. public
  160.  
  161. :m UC:        ¥ ( -- addr len )  Converts string to upper case and gets it.
  162.     get: self  2dup  upper  ;m
  163.  
  164.  
  165. :m PUT: { addr len -- }
  166.         ¥ Replaces entire string with replacement string.  Does NEW:
  167.         ¥ if not already done.
  168.     ?new: self  clear: pos
  169.     0 -1  addr len  munger: self  put: lim  ;m
  170.  
  171. :m ->:  { str ¥ state -- }
  172.         ¥ Replaces self with the active part of string str.  We assume
  173.         ¥ the type, and early bind.  As the replacement may cause the
  174.         ¥ Mem Manager to move things, we lock str for the duration.
  175.  
  176.     str getState: string  -> state   str lock: string
  177.     str get: string   put: self
  178.     state   str setState: string   ;m
  179.  
  180.     
  181. :m INSERT:  { addr len -- }
  182.     ?new: self
  183.     addr 0 addr len  munger: self  put: pos
  184.     len +: lim  ;m
  185.  
  186.  
  187. :m $INSERT:  { str ¥ state -- }
  188.         ¥ Inserts the active text from the given relocatable
  189.         ¥ string, using early binding.  As the memory manager could 
  190.         ¥ move the source string to make room for the increase in 
  191.         ¥ length of SELF, we lock the source string for the
  192.         ¥ operation, then restore its previous state.
  193.  
  194.     str getState: string  -> state  str lock: string
  195.     str get: string  insert: self
  196.     state  str setState: string  ;m
  197.  
  198.  
  199. :m ADD: { addr len -- }
  200.     end: self
  201.     addr len  insert: self  ;m
  202.  
  203.  
  204. :m $ADD:  { str ¥ state -- }
  205.     str getState: string  -> state  str lock: string
  206.     str get: string  add: self
  207.     state  str setState: string  ;m
  208.  
  209.  
  210. :m +:        ¥ ( char -- )  Appends a char to end of string
  211.     pad c!  pad 1 add: self  ;m
  212.  
  213.  
  214. :m PRINT:
  215.     nil?: self
  216.     if   Nopen  else   get: self  type   then   ;m
  217.  
  218. ¥ :m   =: { theobj -- }
  219. ¥        ¥ Assigns this string to any object that accepts ( addr len )
  220. ¥    get: self  put: theobj  ;m
  221.  
  222. :m FILL:    ¥ ( c -- )
  223.     get: self  rot  fill  ;m
  224.  
  225.  
  226. ¥ SEARCH: and CHSEARCH: are somewhat interim.  Class String+ provides more
  227. ¥ efficient versions which also include case handling.  But these versions
  228. ¥ are short, and may be adequate for many needs.
  229.  
  230. :m SEARCH:    ¥ ( addr len -- b )
  231.     0 0  munger: self
  232.     dup 0< if  drop  false  else  put: lim  true  then  ;m
  233.  
  234. :m CHSEARCH:    ¥ ( c -- b )
  235.     pad c!  pad 1  search: self  ;m
  236.  
  237.  
  238. :m DUMP:  { ¥ offs svCurs -- }
  239.     nil?: self  if  Nopen  EXIT  THEN
  240.     curs -> svCurs  -curs
  241.     all: self  swap .h .h  5 spaces
  242.     ." pos: "  pos: self .h  2 spaces
  243.     ." lim: "  lim: self .h  cr
  244.     pos: self 5 - 0 max  -> offs
  245.     all: self  swap offs +  swap offs -  80 min  bounds
  246.     DO  i c@  bl 126 within?
  247.         NIF  ret = IF  $ A6  ELSE  $ D7  THEN
  248.         THEN
  249.         emit
  250.     LOOP  cr
  251.     pos: self  offs - spaces  & P  emit  cr
  252.     lim: self  offs -
  253.     dup 80 < IF  spaces  & L  emit  ELSE  drop  THEN
  254.     ^1st: self  len: self  0 max  $ 140  min  dump
  255.     svCurs -> curs  ;m
  256.  
  257. :m RD:    reset: self  dump: self  ;m        ¥ Handy, and short to type!
  258.  
  259. ;class
  260.  
  261. <" Files
  262.  
  263. +echo
  264.  
  265. : q db
  266.     temp{ string s }
  267.     " hello" put: s
  268.     dump: s  ;
  269.